home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Mac Magazin/MacEasy 25
/
Mac Magazin and MacEasy Magazine CD - Issue 25.iso
/
Grafik & Text
/
Alpha
/
Tcl
/
SystemCode
/
electric.tcl
< prev
next >
Wrap
Text File
|
1996-08-15
|
9KB
|
310 lines
########################################################################
# Mode-dependent auto-indentation
# (modified from original generic indentLine by Tom Pollard
# <pollard@chem.columbia.edu>)
#
# 1. 'indentLine' calls the routine ${mode}indentLine, if it exists,
# else it reverts to Pete's generic indentLine procedure.
# 2. 'indentRegion' calls the routine ${mode}indentRegion, if it
# exists, else it reverts to calling 'indentLine' for each line.
# 3. generic indentLine uses mode-specific comment definition, if it
# exists. (defined below for Tcl, Perl, and C)
#
# Called at all carriage returns.
proc carriageReturn {} {
global mode
global indentOnCR
set indentString ""
deleteText [getPos] [selEnd]
if {$indentOnCR} {
set pos [getPos]
set text [getText [lineStart $pos] $pos]
for {set i 0; set len [string length $text]} {$i <= $len} {incr i} {
set c [string index $text $i]
if {($c != "\t") && ($c != "\ ")} {
set indentString [string range $text 0 [expr $i-1]]
break
}
}
}
insertText "\r" $indentString
}
# doATab may be called with an optional non-zero argument to override
# its interpretation as 'indent-Line' (doesn't break older usage.)
proc doATab {{hard 0}} {
global mode
global ${mode}modeVars
if {$hard || ([info exists ${mode}modeVars] &&
![set ${mode}modeVars(electricTab)])} {
if {[getPos] != [selEnd]} {
replaceText [getPos] [selEnd] "\t"
} else {
insertText "\t"
}
} else {
indentLine
}
}
proc indentLine {} {
global mode
if {[catch {${mode}indentLine}]} {
indentLine0
}
}
proc indentRegion {} {
global mode
if {[catch {${mode}indentRegion}]} {
simpleIndentRegion
}
}
proc simpleIndentRegion {} {
set from [lindex [posToRowCol [getPos]] 0]
set to [lindex [posToRowCol [selEnd]] 0]
select [getPos]
while {$from <= $to} {
goto [rowColToPos $from 0]
indentLine
incr from
}
}
set TclcommentRegexp {^[ \t]*#}
set PerlcommentRegexp {^[ \t]*#}
set cCommentRegexp {/\*([^*]|[^*]\/|\*[^\/]|\r)*\*/}
set CcommentRegexp $cCommentRegexp
set C++commentRegexp $cCommentRegexp
########################################################################
# Generic C-style indentation (works for Tcl and Perl)
#
proc indentLine0 {} {
global mode
global ${mode}commentRegexp cCommentRegexp
if {[info exists ${mode}commentRegexp]} {
set comPat [set ${mode}commentRegexp]
} else {
set comPat $cCommentRegexp
}
set comPat "($comPat|^\[ \]\[ \]*\$)"
set beg [lineStart [getPos]]
set end [nextLineStart [getPos]]
# Find last previous non-comment line and get its leading whitespace
set pos $beg
set lst [search -s -f 0 -r 1 -i 0 {^[ \t]*[^ \t\r]} [expr $pos-1]]
set line [getText [lindex $lst 0] [expr [nextLineStart [lindex $lst 0]] - 1]]
set lwhite [getText [lindex $lst 0] [expr [lindex $lst 1] - 1]]
# Find the last preceding comment block
set prvPos [lindex $lst 0]
if {![catch {search -s -f 0 -r 1 -i 0 $comPat [expr $pos-1]} lstCmt]} {
set begCmt [lindex $lstCmt 0]
set endCmt [lindex $lstCmt 1]
# If current non-blank line is in the comment...
while {$begCmt <= $prvPos && $endCmt >= $prvPos} {
# ...find the last non-blank line that precedes the comment block,
if {![catch {search -s -f 0 -r 1 -i 0 {^[ \t]*[^ \t\r]} [expr $begCmt-1]} lst]} {
set prvPos [lindex $lst 0]
set line [getText [lindex $lst 0] [expr [nextLineStart [lindex $lst 0]] - 1]]
set lwhite [getText [lindex $lst 0] [expr [lindex $lst 1] - 1]]
# ...and the next preceding comment block.
if {![catch {search -s -f 0 -r 1 -i 0 $comPat [expr $prvPos]} lstCmt]} {
set begCmt [lindex $lstCmt 0]
set endCmt [lindex $lstCmt 1]
} else {
break
}
} else {
# Handle search failure at top-of-file
set line "#"
set lwhite ""
break
}
}
}
# This line fails if there's whitespace at the end of the previous line
# set nextC [lookAt [expr [nextLineStart [lindex $lst 1]] - 2]]
#
# set line [getText [lindex $lst 0] [expr [nextLineStart [lindex $lst 0]] - 1]]
#
regexp {([^ \t])[ \t]*$} $line allofit nextC
#
if {($nextC == "\{")} {
append lwhite "\t"
} elseif {$nextC == ":"} {
set lwhite "[string range $lwhite 0 [expr [string length $lwhite]-3]]\t"
}
set text [getText $beg [nextLineStart $beg]]
regexp {^[ \t]*} $text white
set len [string length $white]
set nextC [lookAt [expr $beg + $len]]
if {$nextC == "\}"} {
set lwhite [string range $lwhite 0 [expr [string length $lwhite] - 2]]
}
if {$white != $lwhite} {
replaceText $beg [expr $beg + $len] $lwhite
}
goto [expr $beg + [string length $lwhite]]
}
########################################################################
# Pete's generic indentLine from v6.02
#
proc C++indentLine {} { CindentLine }
proc CindentLine {} {
global mode
set beg [lineStart [getPos]]
set lst [search -s -f 0 -r 1 -i 0 {^[ \t]*[^ \t\r]} [expr $beg-1]]
set lwhite [getText [lindex $lst 0] [expr [lindex $lst 1] - 1]]
set nextC [lookAt [expr [nextLineStart [lindex $lst 1]] - 2]]
if {($nextC == "\{")} {
append lwhite "\t"
} elseif {$nextC == ":"} {
set lwhite "[string range $lwhite 0 [expr [string length $lwhite]-3]]\t"
}
set text [getText $beg [nextLineStart $beg]]
regexp {^[ \t]*} $text white
set len [string length $white]
set nextC [lookAt [expr $beg + $len]]
if {$nextC == "\}"} {
set lwhite [string range $lwhite 0 [expr [string length $lwhite] - 2]]
}
global ${mode}modeVars
if {[string match "*:\r" $text] && [info exists ${mode}modeVars(elecColon)] && [set ${mode}modeVars(elecColon)]} {
if {[string index $lwhite 0] == "\t"} {
set lwhite "[string range $lwhite 1 [expr [string length $lwhite] - 1]] "
}
}
if {$white != $lwhite} {
replaceText $beg [expr $beg + $len] $lwhite
}
goto [expr $beg + [string length $lwhite]]
}
########################################################################
#===============================================================================
proc electricLeft {} {
global mode
global ${mode}modeVars
deleteText [getPos] [selEnd]
if {![set ${mode}modeVars(elecLBrace)]} then {
insertText "\{"
return
}
if {[set ${mode}modeVars(elecLBrace)] && ![catch {search -l [lineStart [expr [lineStart [getPos]] - 1]] -s -f 0 -r 0 "\}" [getPos]} res]} {
set end [getPos]
if {[getPos] != [maxPos]} {
incr end
}
if {[regexp {\}[ \t\r]*else} [getText [lindex $res 0] $end]]} {
set res2 [search -f 0 -r 0 {else} [getPos]]
oneSpace
set text [getText [lindex $res2 0] [getPos]]
if {[lookAt [expr [getPos] - 1]] != " "} {
append text " "
}
replaceText [expr [lindex $res 0] + 1] [getPos] " $text\{\r"
indentLine
return
}
}
set pos [getPos]
set start [lineStart $pos]
set text [getText $start $pos]
for {set i $start} {$i < $pos} {incr i} {
set c [lookAt $i]
if {($c != "\ ") && ($c != "\t")} then {
break;
}
}
set indentation [getText $start $i]
if {($i == $pos) || ([lookAt [expr $pos - 1]] == " ")} {
insertText "\{\r" $indentation "\t"
} else {
insertText " \{\r" $indentation "\t"
}
}
proc electricRight {} {
global mode
global ${mode}modeVars
deleteText [getPos] [selEnd]
if {[set ${mode}modeVars(elecRBrace)] == "0"} then {
insertText "\}"
catch {blink [matchIt "\}" [expr [getPos]-2]]}
return
}
set pos [getPos]
set start [lineStart $pos]
if {[catch {matchIt "\}" [expr $pos-1]} matched]} {
beep
return
}
set text [getText [lineStart $matched] $matched]
regexp {^[ ]*} $text indentation
for {set i $start} {$i < $pos} {incr i} {
set c [lookAt $i]
if {($c != "\ ") && ($c != "\t")} then {
insertText "\r" $indentation "\}\r" $indentation
blink $matched
return
}
}
set text [set indentation]\}\r$indentation
replaceText $start $pos $text
goto [expr {$start + [string length $text]}]
blink [matchIt "\}" [expr $start-2]]
}
proc electricSemi {} {
global mode
global ${mode}modeVars
deleteText [getPos] [selEnd]
if {[set ${mode}modeVars(electricSemi)] == "0"} then {
insertText ";"
return
}
set pos [getPos]
set start [lineStart $pos]
set text [getText $start $pos]
if {[string first "for" $text] != "-1"} {
set lefts 0
set rights 0
set len [string length $text]
for {set i 0} {$i < $len} {incr i} {
case [string index $text $i] in {
"(" { incr lefts }
")" { incr rights }
}
}
global globs
set globs [list $lefts $rights $len]
if {$lefts != $rights} {
insertText ";"
return
}
}
insertText ";\r" [indentString $pos]
}